;;;
;;; JaCoLiB
;;; Copyright (C) 2008 Alessandro Serra
;;; 
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;; 
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;

;;;; Created on 2008-06-27 21:58:39

(in-package :jacolib)

;
; logs & conditions
;

(cl-log:defcategory :protocol-error)
(cl-log:defcategory :protocol-info)

;
; connection
;

(defclass connection ()
  ((socket 
    :TYPE usocket:stream-usocket 
    :INITARG :socket 
    :READER connection-socket)
   (stream 
    :TYPE stream 
    :INITARG :stream 
    :READER connection-stream))
  (:documentation "A connection"))

; constructor 

(defun make-connection (socket) 
  (declare (type usocket:stream-usocket socket))
  (let ((connection (make-instance 'connection :socket socket)))
    connection))

(defmethod initialize-instance :after ((connection connection) &rest initargs)
  (declare (ignore initargs))
  (progn
    (setf (slot-value connection 'stream) 
	  (usocket:socket-stream (connection-socket connection)))))

; write/read functions

(defun connection-write-simple-string (connection str)
  (declare (type connection connection))
  (progn
    (cl-log:log-message :protocol-info "write: ~A" str)
    (if str
        (format (connection-stream  connection) "~A~%" str)
        (format (connection-stream  connection) "~%"))))

(defun connection-read-simple-string (connection)
  (declare (type connection connection))
  (let ((data (read-line (connection-stream connection))))
    (cl-log:log-message :protocol-info "read: ~A" data)
    data))

(defun connection-write-string (connection str)
  (declare (type connection connection))
  (progn
    (cl-log:log-message :protocol-info "write: ~D   ~A" (length str) str)
    (if str
        (format (connection-stream  connection) "~D~%~A" (length str) str)
        (format (connection-stream  connection) "0~%"))))

(defun connection-read-string (connection)
  (declare (type connection connection))
  (let* ((num-to-read (parse-integer (read-line (connection-stream connection))))
         (data (make-string num-to-read)))
    (read-sequence data (connection-stream connection) :start 0 :end num-to-read)
    (cl-log:log-message :protocol-info "read: ~A" data)
    data))

; flush and close

(defun connection-flush (connection)
  (declare (type connection connection))
  (force-output (connection-stream connection)))

(defun connection-close (connection) 
  (declare (type connection connection))
  (connection-write-simple-string connection "close")
  (connection-flush connection)
  (usocket:socket-close (connection-socket connection)))

; I/O 

(defun connection-send-request (connection req)
  (declare (type connection connection))
  (connection-write-simple-string connection "req")
  (connection-write-string connection req)
  (connection-flush connection))

(defun connection-send-response (connection res)
  (declare (type connection connection))
  (connection-write-simple-string connection "res")
  (connection-write-string connection res)
  (connection-flush connection))

(defun connection-send-fatalerror-and-quit (connection msg)
  (declare (type connection connection))
  (connection-write-simple-string connection "fatal-error")
  (connection-write-string connection msg)
  (connection-flush connection)
  (usocket:socket-close (connection-socket connection)))

; step function

(defun connection-receive (connection)
  (declare (type connection connection))
  (handler-case
   (let ((el (connection-read-simple-string connection)))
     (cond 
      ((string-equal el "fatal-error")
       (usocket:socket-close (connection-socket connection))
       (values 'fatal-error (connection-read-string connection)))
      ((string-equal el "close")
       (usocket:socket-close (connection-socket connection))
       (values 'close))
      ((string-equal el "req")
       (values 'request (connection-read-string connection)))
      ((string-equal el "res")
       (values 'response (connection-read-string connection)))
      (t
       (let ((msg "Expected: close, fatal-erro, req, or res key."))
         (connection-send-fatalerror-and-quit connection msg)
         (values 'fatal-error msg)))))
   (error (x) 
     (values 'fatal-error (format t "~A" x)))))
